home *** CD-ROM | disk | FTP | other *** search
- : ' LOCATE ?? ;
- : IMMEDIATE TDP $40 CXR ; IMMEDIATE
- : ['] IMMEDIATE ' COMPILE LIT , ;
- : [COMPILE] IMMEDIATE ?C ' , ;
- : ASCII IMMEDIATE BL WORD 1+ C@ [COMPILE] LITERAL ;
- : =? = ?? ;
- : IF IMMEDIATE COMPILE 0br HERE 2 ALLOT 1 ;
- : ELSE IMMEDIATE 1 =? COMPILE br HERE 2+ SWAP ! HERE 2 ALLOT 1 ;
- : THEN IMMEDIATE 1 =? HERE SWAP ! ;
- : TO IMMEDIATE COMPILING IF COMPILE to ELSE ' 3+ @ ! THEN ;
- : +TO IMMEDIATE COMPILING IF COMPILE +to ELSE ' 3+ @ +! THEN ;
- : WIPE DUP @ CURRENT @ ! TO HERE ;
- : BEGIN IMMEDIATE ?C HERE 2 ;
- : UNTIL IMMEDIATE 2 =? COMPILE 0br , ;
- : WHILE IMMEDIATE 2 =? COMPILE 0br HERE 2 ALLOT 0 ;
- : REPEAT IMMEDIATE 0 =? COMPILE br HERE 2+ SWAP ! , ;
- : do SWAP OVER - NEGATE $8000 + ;
- : DO IMMEDIATE COMPILE do COMPILE 2>R 2R> R> 0 2>R 2>R HERE ;
- : RL COMPILING ?? R>
- BEGIN R> ?DUP
- WHILE HERE SWAP !
- REPEAT >R ;
- : LOOP IMMEDIATE COMPILE lp , 2R> R> RL >R 2>R ;
- : +LOOP IMMEDIATE COMPILE +lp , 2R> R> RL >R 2>R ;
- : LEAVE IMMEDIATE 1 =? COMPILE 2R> COMPILE 2DROP COMPILE br
- 2R> R> HERE 2>R 2>R 2 ALLOT 1 ;
- : N>C COUNT 1F AND + ;
- : C>N 1- BEGIN DUP C@ $80 <
- WHILE 1-
- REPEAT ;
- : C>L C>N 2- ;
- : ME TDP N>C ;
- : CLASS ME PATCH LINK ;
- : VARIABLE CREATE 2 ALLOT LINK ;
- : CONSTANT CREATE , ['] 0 CLASS ;
- : TOVAR CREATE HERE 2+ , 0 , ['] BASE CLASS ;
- TOVAR FENCE
- : VECTOR CREATE LINK ;
- VECTOR FORGET
- : FG ' C>L FENCE OVER U< ?? WIPE ;
- ' FG ' FORGET PATCH
- HERE TO FENCE
- : ABS DUP 0< IF NEGATE THEN ;
- : DABS DUP 0< IF DNEGATE THEN ;
- : MU/MOD >R 0 R@ UM/MOD R> SWAP >R UM/MOD R> ;
- TOVAR HLD
- : PAD HERE 100 + ;
- : <# PAD TO HLD ;
- : #> 2DROP HLD PAD OVER - ;
- : HOLD -1 +TO HLD HLD C! ;
- : # BASE MU/MOD ROT 9 OVER < IF 7 + THEN ASCII 0 + HOLD ;
- : #S BEGIN # 2DUP OR 0= UNTIL ;
- : SIGN 0< IF ASCII - HOLD THEN ;
- : ## <# #S ROT SIGN #> ;
- : . DUP ABS 0 ## TYPE SPACE ;
- : .U 0 <# #S #> TYPE SPACE ;
- : .D DUP ROT SWAP DABS ## TYPE SPACE ;
- BYE
- ə